Programmer Power Tools/Programmer Power Tools.iso/microcrn/issue_44.arc/OR4.ARC/OR4.PAS

Pascal/Delphi Source File | 1988-08-29 | 57.2 KB | 1,629 lines

{-----------------------------------------------------------------------}
{||||||||||||||||             O R  4.0               |||||||||||||||||||}
{-----------------------------------------------------------------------}

 {--------------------------------------------------------------------}
 {      Three Level Hierarchy Object Learning Recognizer Design       }
 {                    Using List Search Methods                       }
 {--------------------------------------------------------------------}

     {-----------------------------------------------------------}
     {                     Written by:                           }
     {                                                           }
     {                       21Aug88                             }
     {                                                           }
     {                      Art Gaffin                           }
     {        1514 Canna Court, Mountain View, CA  94043         }
     {                 Phone: [phone]                     }
     {                                                           }
     {                      Doug Gaffin                          }
     { Dept of Zoology, Oregon State Univ, Corvallis, OR  97331  }
     {                 Phone: [phone]                     }
     {                                                           }
     {                  ALL RIGHTS RESERVED                      }
     {-----------------------------------------------------------}


   {$V-} {$R-}        {$S-}  {tp4}
   uses crt,dos;  {for readkey}{for intr}


{========================= Global Constants: ===========================}
const
   RECOG_MEMORY_SIZE           = 64;
   RECOG_MEMORY_SIZE_MINUS_1   = 63;

const
   g_frame_size       : array [1..4] of word = (   4,    4,    3,    8 );
   g_learn_similarity : array [1..3] of word = (   2,    3,    1 );
   g_recog_similarity : array [1..3] of word = (   2,    1,    1 );
   g_info_level       : array [1..3] of word = (   3,    2,    1 );

   g_perm_mem_thres   : array [1..3] of word = (  20,   25,   25 );
   g_min_recog_freq   : array [1..3] of word = (  20,   25,   25 );
   g_jitter_flag      : array [1..3] of word = (   0,    1,    1 );
   g_fatigue_flag     : array [1..3] of word = (   0,    1,    1 );

   g_forget_threshold : array [1..3] of word = (  20,   25,   25 );
   g_forget_level     : array [1..3] of word = ( 200,  200,  400 );
   g_ration_level     : array [1..3] of word = ( 100,  200,  400 );

{========================= Utility Constants: ==========================}

const
   CONTINUE_MODE      = 0;
   EXIT_MODE          = 1;

   IDLE_MODE          = 0;

   LEARN_1_MODE       = 1;
   LEARN_2_MODE       = 2;
   LEARN_3_MODE       = 3;

   RECOG_1_MODE       = 4;
   RECOG_2_MODE       = 5;
   RECOG_3_MODE       = 6;

   MANUAL             = 0;
   AUTO               = 1;

   AUTO_PASSES_1      = 1000;
   AUTO_PASSES_2      = 1500;
   AUTO_PASSES_3      = 1000;

   NORMAL_SPEED       = 0;
   FAST_SPEED         = 1;
   SLOW_SPEED         = 2;


{ ----------- declarations for menu across top of screen: ------------- }
const
   TOP_LINE_NUM_ITEMS = 7;

   Across_Top_Msg : string =
'|'#27'@ -left   |'#26'@ -right   |'#17#217'@ -select    |(esc)@ -STOP process';

   Display_Mem_Msg : string =
'|(esc)@,|Q@ -exit mode   |<any key>@ -toggles scroll on/off';

   Exit_Msg : string =
'|(esc)@,|Q@ -exit/finish    |Y@ -go ahead and exit   |N@ -do NOT exit';

   Pop_Down_Msg : string =
'|(esc)@ -exit menu   |'#24'@ -up   |'#25'@ -down   |'#17#217'@ -select';

   top_line_selno         : integer = 1;

   help_index_selno       : integer = 1;
   help_index_x           : integer = 25;
   help_index_y           : integer = 10;

   learn_selno            : integer = 1;
   learn_x                : integer = 26;

   recognize_selno        : integer = 1;
   recognize_x            : integer = 35;

   display_mem_selno      : integer = 1;
   display_mem_x          : integer = 48;

   exit_x                 : integer = 1;


{===================== Global Type Declarations: =======================}

type
   FRAME_8      = array [0..7] of word;
   CELL_8 = record
                element : FRAME_8;
               frequency : integer;
            end;
   MEMORY_8 = array [0..RECOG_MEMORY_SIZE_MINUS_1] of CELL_8;

   SCREEN_BUF = array [0..79] of word;


{===================== Global Data Declarations: =======================}

const
   g_beep_mode      : word = 1;
   g_exit_mode      : word = 0;
   g_op_mode        : word = 0;
   g_auto_mode      : word = 0;
   g_speed_mode     : word = 0;

var
   g_screen_buf     : SCREEN_BUF;
   g_old_screen_buf : SCREEN_BUF;


{================ Recognizer #1 Global Data Declarations ===============}

var
   recog_memory_1     : MEMORY_8;
   recog_memory_2     : MEMORY_8;
   recog_memory_3     : MEMORY_8;

   g_memory_num       : word;


{============================ Includes: ================================}

{$I PC_Box.pas}

{----------------------------------------------------------------------------}
procedure  Set_Window_Area  (X,Y,Width,Height:integer);
begin
   Window(X, Y, (X + Width - 1), (Y + Height - 1));  GotoXY(1, 1);
end;  {Set_Window_Area}

{----------------------------------------------------------------------------}
procedure  Set_Color  (T,B:integer);
begin
   TextColor(T); TextBackground(B);
end;  {Set_Color }

{----------------------------------------------------------------------------}
procedure  Beep  (Freq,Duration : integer);
begin
   if ( g_beep_mode = 1 ) then begin
      if (Duration > 0) then begin
         sound(Freq); delay(Duration); nosound;
      end
      else begin
         sound(Freq); sound(Freq); nosound;
      end;
   end;
end;  {Beep}

{================= Turbo Pascal Version 3.0 =================================}
(*
function ReadKey : char;
var
   TmpChar : char;
begin
   read(kbd,TmpChar);
   ReadKey := TmpChar;
end;  {ReadKey}
{----------------------------------------------------------------------------}
procedure  Empty_KeyBuf;
var
   DummyChar : char;
begin
   while (keypressed) do DummyChar := ReadKey;
end;  {Empty_KeyBuf}
{----------------------------------------------------------------------------}
function  GetKey : char;
var
   TmpChar : char;
begin
   { Get Keyboard Char - conv ==> Upcase, Fn= +150, Ck for valid }
   TmpChar := ReadKey;
   if ((TmpChar = Chr(27)) and KeyPressed)
      then  begin  TmpChar := ReadKey;  GetKey := chr(ord(TmpChar) + 150);  end
      else  GetKey := upcase(TmpChar);
end;  {GetKey}
  *)
{================= Turbo Pascal Version 4.0 =================================}
(**)
procedure  Empty_KeyBuf;
var
   DummyChar : char;
begin
   while (keypressed) do DummyChar := ReadKey;
end;  {Empty_KeyBuf}
{----------------------------------------------------------------------------}
function  GetKey : char;
var
   TmpChar : char;
begin
   { Get Keyboard Char - conv ==> Upcase, Fn= +150, Ck for valid }
   TmpChar := ReadKey;
   if (TmpChar = #0)
      then  begin  TmpChar := ReadKey;  GetKey := chr(ord(TmpChar) + 150);  end
      else  GetKey := upcase(TmpChar);
end;  {GetKey}
(**)
{============================================================================}
procedure  Rev_Video; begin  TextBackground(White); TextColor(Black); end;
procedure  High_Video; begin  TextBackground(Black); TextColor(White); end;
procedure  Med_Video; begin  TextBackground(Black); TextColor(LightGray); end;

{----------------------------------------------------------------------------}
procedure  Clear_Msg_Line( Y_Loc:word );
begin
   Set_Window_Area(1,Y_Loc,80,1);  Med_Video;  clrscr;
end;  {Clear_Msg}

{----------------------------------------------------------------------------}
procedure  Msg_Line( Y_Loc:word; Msg:string );
var
   c : char;
   i : integer;
begin
   Set_Window_Area(1,Y_Loc,80,1);  Med_Video;  clrscr;
   gotoXY(1,1);
   for i := 1 to length(Msg) do begin
      c := Msg[i];
      case c of
      '^': High_Video;
      '|': Rev_Video;
      '@': Med_Video;
      else write(c);
      end;  {end case}
   end;
end;  {Msg_Line}


{============================ Includes: ================================}

{$I PullDown.pas}
{$I Help.pas}

{=======================================================================}
{ Display_Word:                                                         }
{=======================================================================}

procedure  Display_Word ( passed_string:STRING;
                          passed_word : word );
begin
   if ( length(passed_string) = 0 ) then begin
      Draw_Window_Box( 60,15,19,5, 'Debug' );
   end
   else begin
      Set_Window_Area(60,15,19,5); High_Video;
      gotoXY(2,5);
      writeln( passed_string:10, passed_word:5 );
   end;
end;  {Display_Word}


{=======================================================================}
{ Display_Message_1:                                                    }
{=======================================================================}

procedure  Display_Message_1;
begin
   save_screen_1;
   Draw_Window_Box( 25,8, 32,5, '' );
   gotoXY(3,3); writeln('    An OBJECT occurs when ' );
   gotoXY(3,4); writeln('   two or more stimuli are ');
   gotoXY(3,5); writeln(' repeatedly observed together. ');
   delay(2000);
   restore_screen_1;
end;  {Display_Message_1}


{=======================================================================}
{ Display_Credits:                                                      }
{=======================================================================}

procedure  Display_Credits;
begin
   Draw_Window_Box( 21,7, 35,14, 'credits' );
   gotoXY(3,3);   writeln('         --  O R 4  --');
   gotoXY(3,4);   writeln('3 Level Hierarchy Object Learning');
   gotoXY(3,6);   writeln('    Doug Gaffin / Art Gaffin');
   gotoXY(3,7);   writeln('           21Aug88');
   gotoXY(3,9);   writeln('Dept of Zoology, Oregon State Univ');
   gotoXY(3,10);  writeln('      Corvallis, OR 97331');
   gotoXY(3,12);  writeln('     Phone: [phone]');
   gotoXY(3,13);  writeln('            [phone]');
end;  {Display_Credits}


{=======================================================================}
{ Display_Current_Status:                                               }
{=======================================================================}

procedure  Display_Current_Status;
begin
   Draw_Window_Box( 1,21, 13,1, 'mode' );
   gotoXY(2,2);
   case g_op_mode of
   IDLE_MODE:    write( '  I D L E' );
   RECOG_1_MODE: write( ' RECOGNIZE 1' );
   RECOG_2_MODE: write( ' RECOGNIZE 2' );
   RECOG_3_MODE: write( ' RECOGNIZE 3' );
   LEARN_1_MODE: write( ' L E A R N 1' );
   LEARN_2_MODE: write( ' L E A R N 2' );
   LEARN_3_MODE: write( ' L E A R N 3' );
   end;
end;  {Display_Current_Status}

{=======================================================================}
{ Display_Response:                                                     }
{=======================================================================}

procedure  Display_Response( x,y, response : word );

begin
   Set_Window_Area(x,y,64,2);
   Med_Video;  clrscr;
   gotoXY( response+1, 1 );
   Rev_Video; write(response:2);
   Med_Video;
end;


{=======================================================================}
{ Init_Stimulus_Window:                                                 }
{=======================================================================}

procedure  Init_Stimulus_Window( x,y,z : word;
                                 header : string );
var
   width : word;
begin
   { ------------ prepare screen recognizer memory data: ---------------}
   width := g_frame_size[g_memory_num]*3+8;
   Set_Window_Area(x+1,y+1,width,z);  rev_video;  clrscr;
   draw_window_box(x,y, width,z, header);
end;  {Init_Stimulus_Window}



{=======================================================================}
{ Display_Stimulus_Window:                                              }
{=======================================================================}

procedure  Display_Stimulus_Window ( x,y,z : word;
                                     stimulus       : FRAME_8 );
const
   display_count : array[1..4] of word = ( 0, 0, 0, 0 );
var
   index_x, width  : word;

begin

   { ------------ prepare screen recognizer memory data: ---------------}
   width := g_frame_size[g_memory_num]*3+8;
   Set_Window_Area(x+1,y+1,width,z);  High_Video;

   { --- write data - it will scroll up within window automatically: -- }
   display_count[g_memory_num] := display_count[g_memory_num] + 1;
   gotoXY(1,z);
   writeln;
   write( display_count[g_memory_num]:5,' ' );
   for index_x := 0 to g_frame_size[g_memory_num]-1 do begin
      if (stimulus[index_x] = 63)
         then Rev_Video
         else Med_Video;
      write(stimulus[index_x]:3);
   end;
   Med_Video;

end;  {Display_Stimulus_Window}



{=======================================================================}
{ Displ_Mem:  display contents of recognizer memory                   }
{=======================================================================}

procedure  Displ_Mem( recog_memory : MEMORY_8 );

label
   Exit_Point;
var
   index_x, index_y  : word;
   freq, temp_value  : word;
   dummy_char        : char;

begin
   Save_Screen_1;

   Msg_Line( 25, Display_Mem_Msg );

   { ------------ prepare screen recognizer memory data: ---------------}
   Set_Window_Area(18,5,42,17);  gotoXY(1,1);  High_Video;
   draw_window_box(18,5,42,17, 'Resp #      cell contents:     freq:');

   Set_Window_Area(19,6,42,17);  gotoXY(1,1);  High_Video;

   { --- write data - it will scroll up within window automatically: -- }
   for index_y := 0 to ( RECOG_MEMORY_SIZE - 1 ) do begin

      freq := recog_memory[index_y].frequency;

      if ( freq >= g_perm_mem_thres[g_memory_num] )
         then High_Video
         else Med_Video;

      write( index_y:5, '    ' );

      if ( keypressed ) then begin
         dummy_char := readkey;
         if ( dummy_char in [#27,'Q','q'] ) then goto Exit_Point;
         dummy_char := readkey;
      end;


      for index_x := 0 to g_frame_size[g_memory_num]-1 do begin
         temp_value := recog_memory[index_y].element[index_x];
         if ( freq >= g_perm_mem_thres[g_memory_num] )
            then High_Video
            else Med_Video;
         if (temp_value = 63)
            then Rev_Video;
         write( temp_value:3 );
      end;

      {---------------- highlight freq if at threshold: ----------------}
      if ( freq >= g_perm_mem_thres[g_memory_num] )
         then High_Video
         else Med_Video;
      writeln( freq:6);

      { -------- vary the scrolling rates according to content: ------- }
      if ( freq >= g_perm_mem_thres[g_memory_num] ) then begin
         beep(1500, 5); delay(400);
      end;
      delay(40);
   end;
   delay(500);
Exit_Point:
   Restore_Screen_1;
end;  {Displ_Mem}



{=======================================================================}
{ Init_Stimulus:                                                        }
{=======================================================================}

procedure  Init_Stimulus( var stimulus : FRAME_8 );
var
   index : word;
begin
   for index := 0 to 7 do begin
      stimulus[index] := 0;
   end;
end; {Init_Stimulus}



{=======================================================================}
{ Init_Memory:                                                          }
{    Initialize generalization memory and parameters for recognizer #1. }
{=======================================================================}

procedure  Init_Memory( var recog_memory : MEMORY_8 );
var
   index_1 : word;
   index_2 : word;
begin
   for index_1 := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
      for index_2 := 0 to 7 do begin
         recog_memory[index_1].element[index_2] := 0;
      end;
      recog_memory[index_1].frequency := 0;
   end;
end; {Init_Memory}



{=======================================================================}
{ Gen_Stimulus_Input:                                                   }
{    Generates a stimulus using pseudo random number generator with one }
{    relatively frequent stimulus randomly superimposed on the stream.  }
{    This is to see if the learning system will assign it a cell and an }
{    appropriate response value.                                        }
{=======================================================================}

procedure Gen_Stimulus_Input( var stimulus : FRAME_8 );
const
   element_phase_1 : word = 0;
   element_phase_2 : word = 0;
   element_phase_3 : word = 0;

   {-------------------- pattern to superimpose: -----------------------}
   pattern_1 : array [1..8] of array [0..7] of word = (
     ( 063, 063, 000, 000, 000, 000, 000, 000 ),
     ( 000, 063, 063, 000, 000, 000, 000, 000 ),
     ( 000, 000, 063, 063, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ) );

   pattern_2 : array [1..8] of array [0..7] of word = (
     ( 000, 000, 063, 063, 000, 000, 000, 000 ),
     ( 000, 063, 063, 000, 000, 000, 000, 000 ),
     ( 063, 063, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ) );

   pattern_3 : array [1..8] of array [0..7] of word = (
     ( 063, 000, 000, 063, 000, 000, 000, 000 ),
     ( 000, 063, 063, 000, 000, 000, 000, 000 ),
     ( 063, 000, 000, 063, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ),
     ( 000, 000, 000, 000, 000, 000, 000, 000 ) );

var
   index : word;

begin

   {----------------- generate pseudo random stimulus: -----------------}
   for index := 0 to 7 do
      stimulus[index] := random( 64 );

   {--- superimpose multi-frame patterns at pseudo random intervals: ---}
   if ( random( 16 ) = 5 ) and
      ( element_phase_1 = 0 ) and
      ( element_phase_2 = 0 ) and
      ( element_phase_3 = 0 )  {so no overlapping patterns}
      then element_phase_1 := 1;  {=1 kicks off 8-frame pattern}

   if ( random( 16 ) = 15 ) and
      ( element_phase_1 = 0 ) and
      ( element_phase_2 = 0 ) and
      ( element_phase_3 = 0 )  {so no overlapping patterns}
      then element_phase_2 := 1;  {=1 kicks off 8-frame pattern}

   if ( random( 16 ) = 15 ) and
      ( element_phase_1 = 0 ) and
      ( element_phase_2 = 0 ) and
      ( element_phase_3 = 0 )  {so no overlapping patterns}
      then element_phase_3 := 1;  {=1 kicks off 8-frame pattern}

   {--- superimpose patterns on stimulus according to current phase: ---}
   if (element_phase_1 > 0) and (element_phase_1 <= 8) then begin
      for index := 0 to 7 do begin
         if (pattern_1[element_phase_1][index] <> 0)
            then stimulus[index] := pattern_1[element_phase_1][index];
      end;
      element_phase_1 := element_phase_1 + 1;
      if (element_phase_1 = 9) then element_phase_1 := 0;
   end;

   if (element_phase_2 > 0) and (element_phase_2 <= 8) then begin
      for index := 0 to 7 do begin
         if (pattern_2[element_phase_2][index] <> 0)
            then stimulus[index] := pattern_2[element_phase_2][index];
      end;
      element_phase_2 := element_phase_2 + 1;
      if (element_phase_2 = 9) then element_phase_2 := 0;
   end;

   if (element_phase_3 > 0) and (element_phase_3 <= 8) then begin
      for index := 0 to 7 do begin
         if (pattern_3[element_phase_3][index] <> 0)
            then stimulus[index] := pattern_3[element_phase_3][index];
      end;
      element_phase_3 := element_phase_3 + 1;
      if (element_phase_3 = 9) then element_phase_3 := 0;
   end;

end;  {Gen_Stimulus_Input}



{=======================================================================}
{ Calculate_Similarity:                                                 }
{    Compare each of 8 elements of one stimulus with the coresponding   }
{    element of the other stimulus and calculate the total number       }
{    [0..8] of good compares.  A returned value of 8 means a perfect    }
{    match.                                                             }
{=======================================================================}

function  Calculate_Similarity( stimulus_1  : FRAME_8;
                                stimulus_2  : FRAME_8 ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   cum_sim, cum_sim_1, cum_sim_2, cum_sim_3 : word;
   cum_sim_4, cum_sim_5, index : word;

{ ----------------------- function body: ------------------------------ }
begin
   if ( g_jitter_flag[g_memory_num] = 0 ) then begin
      cum_sim := 0;
      for index := 0 to g_frame_size[g_memory_num]-1 do

         if ( stimulus_1[index] = stimulus_2[index] ) then begin
            if ( stimulus_1[index] <> 0 )
               then cum_sim := cum_sim + 1;
         end;

      Calculate_Similarity := cum_sim;
   end
   else begin

      {------------------------- shift one left: -----------------------}
      cum_sim_1 := 0;
      for index := 0 to g_frame_size[g_memory_num]-3 do

         if ( stimulus_1[index] = stimulus_2[index+2] ) then begin
            if ( stimulus_1[index] <> 0 )
               then cum_sim_1 := cum_sim_1 + 1;
         end;

      {---------------------------- no shift: --------------------------}
      cum_sim_2 := 0;
      for index := 0 to g_frame_size[g_memory_num]-2 do

         if ( stimulus_1[index] = stimulus_2[index+1] ) then begin
            if ( stimulus_1[index] <> 0 )
               then cum_sim_2 := cum_sim_2 + 1;
         end;

      {------------------------ shift one right: -----------------------}
      cum_sim_3 := 0;
      for index := 0 to g_frame_size[g_memory_num]-1 do

         if ( stimulus_1[index] = stimulus_2[index] ) then begin
            if ( stimulus_1[index] <> 0 )
               then cum_sim_3 := cum_sim_3 + 1;
         end;

      {------------------------ shift one right: -----------------------}
      cum_sim_4 := 0;
      for index := 0 to g_frame_size[g_memory_num]-2 do

         if ( stimulus_1[index+1] = stimulus_2[index] ) then begin
            if ( stimulus_1[index+1] <> 0 )
               then cum_sim_4 := cum_sim_4 + 1;
         end;

      {------------------------ shift one right: -----------------------}
      cum_sim_5 := 0;
      for index := 0 to g_frame_size[g_memory_num]-3 do

         if ( stimulus_1[index+2] = stimulus_2[index] ) then begin
            if ( stimulus_1[index+2] <> 0 )
               then cum_sim_5 := cum_sim_5 + 1;
         end;

      {---------------- calculate maximum of 3 values: -----------------}
      cum_sim := cum_sim_1;
      if ( cum_sim_2 > cum_sim ) then cum_sim := cum_sim_2;
      if ( cum_sim_3 > cum_sim ) then cum_sim := cum_sim_3;
      if ( cum_sim_4 > cum_sim ) then cum_sim := cum_sim_4;
      if ( cum_sim_5 > cum_sim ) then cum_sim := cum_sim_5;

      Calculate_Similarity := cum_sim;
   end;
end; {Calculate_Similarity}



{=======================================================================}
{ Find_Most_Similar_Cell:                                               }
{    1) Search memory for a cell that is most similar to the input      }
{       stimulus.                                                       }
{                                                                       }
{    2) Return the cell number as the value of the function             }
{                                                                       }
{    3) Return the similarity level of that selected cell in            }
{       most_similar_level                                              }
{=======================================================================}

function  Find_Most_Similar_Cell( stimulus               : FRAME_8;
                                  recog_memory           : MEMORY_8;
                                  var most_similar_level : word ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   index_1, index_2   : word;
   most_similar_addr  : word;
   similarity_level   : word;

{ ----------------------- function body: ------------------------------ }
begin
   most_similar_level := 0;
   most_similar_addr  := 0;

   {--- start list scan from a random place - eliminates preference: ---}
   index_2 := random( RECOG_MEMORY_SIZE );

   for index_1:= 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin

      {--------------------- loop back around: -------------------------}
      if ( index_2 = RECOG_MEMORY_SIZE_MINUS_1 )
         then index_2 := 0
         else index_2 := index_2 + 1;

      similarity_level :=
         Calculate_Similarity( stimulus,
                               recog_memory[index_2].element );

      {------------------- save first most similar: --------------------}
      if ( similarity_level > most_similar_level ) then begin
         most_similar_level := similarity_level;
         most_similar_addr  := index_2;
      end;
   end;
   Find_Most_Similar_Cell := most_similar_addr;
end; {Find_Most_Similar_Cell}



{=======================================================================}
{ Find_Available_Cell:                                                  }
{    Look for unused cell - one with frequency = 0.  Return the cell    }
{    number.                                                            }
{=======================================================================}

function  Find_Available_Cell( recog_memory        : MEMORY_8;
                               var none_avail_flag : word ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   index, rnd_index : word;

{ ------------------------- function body: ---------------------------- }
begin
   none_avail_flag := 0;
   Find_Available_Cell := 0;
   for index := 0 to (RECOG_MEMORY_SIZE_MINUS_1 div 2) do begin
      rnd_index := random(RECOG_MEMORY_SIZE_MINUS_1) + 1;
      if ( recog_memory[rnd_index].frequency = 0 ) then begin
         Find_Available_Cell := rnd_index;
         exit;
      end;
   end;
   none_avail_flag := 1;
end; {Find_Available_Cell}



{=======================================================================}
{ Find_Weak_Cell:                                                       }
{    Look for cell with the lowest frequency and less than the          }
{    g_perm_mem_thres[g_memory_num].                                    }
{=======================================================================}

function  Find_Weak_Cell( recog_memory        : MEMORY_8;
                          var none_avail_flag : word ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   index, rnd_index, weakest_cell_freq, weakest_cell_num : word;

{ ------------------------- function body: ---------------------------- }
begin
   weakest_cell_freq := $0FFF;
   weakest_cell_num := 0;
   Find_Weak_Cell := 0;
   for index := 0 to (RECOG_MEMORY_SIZE_MINUS_1 div 2) do begin
      rnd_index := random(RECOG_MEMORY_SIZE_MINUS_1) + 1;
      if ( recog_memory[rnd_index].frequency < weakest_cell_freq ) then begin
         weakest_cell_freq := recog_memory[rnd_index].frequency;
         weakest_cell_num := rnd_index;
      end;
   end;

   if ( weakest_cell_freq < g_perm_mem_thres[g_memory_num] ) then begin
      Find_Weak_Cell := weakest_cell_num;
      none_avail_flag := 0;
   end
   else begin
      Find_Weak_Cell := 0;
      none_avail_flag := 1;
   end;

end; {Find_Weak_Cell}



{=======================================================================}
{ Rationalize_Freqs:                                                    }
{    This function totals all freq's and normalizes them while          }
{    preserving relative values.                                        }
{=======================================================================}

procedure  Rationalize_Freqs( var recog_memory : MEMORY_8 );
var
   freq, total_freq, ave_freq, index : word;
begin
   {------------- calulate total of all freq's in memory: --------------}
   total_freq := 0;
   for index := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
      freq := recog_memory[index].frequency;
      total_freq := total_freq + freq;
   end;

   {---------------- rationalize all freq's in memory: -----------------}
   ave_freq := total_freq div RECOG_MEMORY_SIZE;
   if (ave_freq > 8) then begin
      for index := 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin
         if ( recog_memory[index].frequency <
              g_perm_mem_thres[g_memory_num] ) then begin
         recog_memory[index].frequency  :=
            recog_memory[index].frequency div 2;
         end;
      end;
   end;
end;  {Rationalize_Freqs}



{=======================================================================}
{ Info_Content:                                                         }
{    Calculates the number of non-zero elements in frame.               }
{=======================================================================}

function  Info_Content( stimulus : FRAME_8 ) : word;
var
   index, total_non_zeroes : word;
begin
   total_non_zeroes := 0;
   for index := 0 to g_frame_size[g_memory_num]-1 do begin
      if ( stimulus[index] <> 0 )
         then total_non_zeroes := total_non_zeroes + 1;
   end;
   Info_Content := total_non_zeroes;
end;  {Info_Content}



{=======================================================================}
{ Forget_One:                                                           }
{    Select one cell of memory, and if below a threshold, erase cell    }
{    contents.                                                          }
{=======================================================================}

procedure  Forget_One( var recog_memory : MEMORY_8 );
var
   selected_cell, cell_freq, index : word;
begin
   selected_cell := random( RECOG_MEMORY_SIZE );
   cell_freq := recog_memory[selected_cell].frequency;

   {--------------------  should we erase the cell?: -------------------}
   if ( selected_cell <> 0 ) and
      ( cell_freq < g_forget_threshold[g_memory_num] ) then begin

      {--------------------- yes, erase the cell: ----------------------}
      Beep( 330, 5 );
      for index := 0 to 7 do
         recog_memory[selected_cell].element[index] := 0;
      recog_memory[selected_cell].frequency := 0;
   end;

end;  {Forget_One}


{=======================================================================}
{ Learn:                                                                }
{    1) Search for the most similar cell to the input stimulus.         }
{                                                                       }
{    2) If not similar enough, look for unused cell to initialize with  }
{       this stimulus.                                                  }
{                                                                       }
{    3) If all are used, then find the cell with the weakest learning   }
{       (lowest frequency), destroy its contents, and initialize with   }
{       this stimulus.                                                  }
{=======================================================================}

procedure  Learn( stimulus         : FRAME_8;
                  var recog_memory : MEMORY_8 );

{-------------------------- declarations: ------------------------------}
const
   learn_pass_num : array [1..3] of word = (0, 0, 0);

var
   most_similar_level           : word;
   memory_address, new_cell_num : word;
   index, freq, none_avail_flag : word;
   local_pass_num               : word;

{------------------------ function body: -------------------------------}
begin

   {---------------------- rationalize freq's: -------------------------}
   learn_pass_num[g_memory_num] := learn_pass_num[g_memory_num] + 1;
   local_pass_num := learn_pass_num[g_memory_num];
   if ( g_ration_level[g_memory_num] > 0 )
      then if ( (local_pass_num mod g_ration_level[g_memory_num]) = 0 )
         then Rationalize_Freqs( recog_memory );

   {---------------if interval is finished, FORGET one: ----------------}
   if ( (local_pass_num mod g_forget_level[g_memory_num]) = 0 ) then begin
      Forget_One( recog_memory );
   end;

   {------------ switch modes for auto mode if necessary: --------------}
   if ( g_auto_mode = AUTO ) then begin

      {----------- periodically display appropriate memory: ------------}
      if ( (local_pass_num mod 1000) = 0 ) then begin
         case g_op_mode of
         LEARN_1_MODE: begin
                          g_memory_num := 1; Displ_Mem( recog_memory_1 );
                       end;
         LEARN_2_MODE: begin
                          g_memory_num := 2; Displ_Mem( recog_memory_2 );
                       end;
         LEARN_3_MODE: begin
                          g_memory_num := 3; Displ_Mem( recog_memory_3 );
                       end;
         end;  {end case}
      end;

      {------------------ switch modes automatically: ------------------}
      case g_op_mode of
      LEARN_1_MODE: if (local_pass_num >= AUTO_PASSES_1 ) then begin
                       g_op_mode := LEARN_2_MODE;
                       Display_Current_Status;
                    end;
      LEARN_2_MODE: if (local_pass_num >= AUTO_PASSES_2 ) then begin
                       g_op_mode := LEARN_3_MODE;
                       Display_Current_Status;
                    end;
      LEARN_3_MODE: if (local_pass_num >= AUTO_PASSES_3 ) then begin
                       g_auto_mode := MANUAL;
                       g_op_mode := RECOG_3_MODE;
                       Display_Current_Status;
                    end;
      end;
   end;

   {-----------------  exit procedure if too many zeros: ---------------}
   if ( Info_Content( stimulus ) < g_info_level[g_memory_num] ) then begin
      exit;
   end;

   {------- find most similar cell in recog_memory to stimulus: --------}
   memory_address := Find_Most_Similar_Cell( stimulus,
                                             recog_memory,
                                             most_similar_level );


   {-------- is it close enough to bump existing targeted cell? --------}
   if ( most_similar_level >= g_learn_similarity[g_memory_num] ) and
      ( memory_address <> 0 ) then begin

      {----------- close enough to map into existing cell: -------------}
      freq := recog_memory[memory_address].frequency;

      {------------------ increment frequency count: -------------------}
      if ( freq < g_perm_mem_thres[g_memory_num] ) then begin
         recog_memory[memory_address].frequency :=
            recog_memory[memory_address].frequency + 1;
         Beep(3500,1);
      end
      else begin
         {----------- mature cell - do NOT increment frequency: --------}
      end;

   end

   { --------- not similar enough? - if so, extablish new one: -------- }
   else begin

      { ------ if space is available, allocate additional cell: ------- }
      new_cell_num := Find_Available_Cell( recog_memory, none_avail_flag );

      if ( none_avail_flag = 0 ) then begin

         { ------ found space, put stimulus (glimpse) into cell: ------ }
         for index := 0 to g_frame_size[g_memory_num]-1 do
             recog_memory[new_cell_num].element[index] := stimulus[index];

         { --------------- start frequency count at 1: ---------------- }
         recog_memory[new_cell_num].frequency := 1;
      end

      else begin
         { -------------- no space, replace weakest one: -------------- }
         new_cell_num := Find_Weak_Cell( recog_memory,
                                         none_avail_flag );

         if ( none_avail_flag = 0 ) then begin
            for index := 0 to g_frame_size[g_memory_num]-1 do
               recog_memory[new_cell_num].element[index] := stimulus[index];

            { --------------- start frequency count at 1: ---------------- }
            recog_memory[new_cell_num].frequency := 1;
            Beep( 500, 1 );
         end;
      end;
   end;
end; {Learn}



{=======================================================================}
{ Find_Most_Recog_Cell:                                                 }
{    1) Search memory for a frequency qualified cell that is most       }
{       similar to the input stimulus.                                  }
{                                                                       }
{    2) Return the cell number as the value of the function             }
{                                                                       }
{    3) Return the similarity level of that selected cell in            }
{       most_similar_level                                              }
{=======================================================================}

function  Find_Most_Recog_Cell( stimulus               : FRAME_8;
                                recog_memory           : MEMORY_8;
                                var most_similar_level : word ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   index_1, most_similar_addr, similarity_level  : word;

{ ----------------------- function body: ------------------------------ }
begin
   most_similar_level := 0;
   most_similar_addr  := 0;

   for index_1:= 0 to RECOG_MEMORY_SIZE_MINUS_1 do begin

      similarity_level :=
         Calculate_Similarity( stimulus,
                               recog_memory[index_1].element );

      {--------- only look at cells with qualified frequencies: --------}
      if ( recog_memory[index_1].frequency >=
              g_min_recog_freq[g_memory_num] ) then begin

         {------------------ save first most similar: ------------------}
         if ( similarity_level > most_similar_level ) then begin
            most_similar_level := similarity_level;
            most_similar_addr  := index_1;
         end;
      end;
   end;
   Find_Most_Recog_Cell := most_similar_addr;
end; {Find_Most_Recog_Cell}



{=======================================================================}
{ Recognize:                                                            }
{    1) Search recog_memory for the cell that is most similar to the    }
{       input stimulus.                                                 }
{                                                                       }
{    2) If the similarity is within a limit set by  MIN_RECOG_DIFF,     }
{       recognition is established and the similarity level.            }
{=======================================================================}

function  Recognize( stimulus     : FRAME_8;
                     recog_memory : MEMORY_8 ) : word;

{ ------------------------- declarations: ----------------------------- }
var
   most_similar_level   : word;
   memory_address, freq : word;

begin
   Recognize := 0;

   {-----------------  exit procedure if too many zeros: ---------------}
   if ( Info_Content( stimulus ) < g_info_level[g_memory_num] ) then begin
      exit;
   end;

   { ------- find most similar cell in recog_memory to stimulus: ------ }
   memory_address := Find_Most_Recog_Cell( stimulus,
                                           recog_memory,
                                           most_similar_level );

   { -------------- is it close enough to be recognized? -------------- }
   if ( most_similar_level >= g_recog_similarity[g_memory_num] ) then begin

      { -------------------- established cell?: ----------------------- }
      freq := recog_memory[memory_address].frequency;
      if ( freq >= g_min_recog_freq[g_memory_num] ) then begin

         { ----------- beep to demonstrate recognition: --------------- }
         Recognize := memory_address;
      end;
   end;
end;  {Recognize}



{=======================================================================}
{ Expand:                                                               }
{    Pushes response into stimulus.  It treats it as a FIFO buffer.     }
{=======================================================================}

procedure  Expand( response     : word;
                   var stimulus : FRAME_8 );
var
   index : word;
begin
   for index := 7 downto 1 do begin
      stimulus[index] := stimulus[index-1];
   end;
   stimulus[0] := response;
end;  {Expand}



{=======================================================================}
{ Help_Index_Menu:                                                      }
{=======================================================================}

procedure  Help_Index_Menu;
var
   Exit_Sw : integer;
begin
   Save_Screen_1;
   Help_Menu(10,7,'Help.txt','Instructions');
   Restore_Screen_1;
end;  {Help_Index_Menu}



{=======================================================================}
{ Exit_Menu:                                                            }
{=======================================================================}

procedure  Exit_Menu;
var
   Exit_Sw : integer;
   YesNo_Ch : char;
begin
   Save_Screen_1;
   Msg_Line( 25, Exit_Msg );
   YesNo_Menu(Exit_x, 2, 'OK?', YesNo_Ch, Exit_Sw);
   if (Exit_Sw = 1) then begin
      case YesNo_Ch of
      'Y': g_exit_mode := 1;
      'N': g_exit_mode := 0;
      end;  {end case}
   end;
   Restore_Screen_1;
end;  {Exit_Menu}


{=======================================================================}
{ Learn_Menu:                                                           }
{=======================================================================}

procedure  Learn_Menu;
var
   Exit_Sw : integer;
begin
   Save_Screen_1;
   Msg_Line( 25, Pop_Down_Msg );
   PullDown_Menu(Learn_x,2,'',
                 'Level #1/Level #2/Level #3',
                 '       ^/       ^/       ^',
                 Learn_SelNo, Exit_Sw);

   Restore_Screen_1;
   if (Exit_Sw = 1) then begin
      case Learn_SelNo of
      1: begin g_op_mode := LEARN_1_MODE; g_auto_mode := MANUAL; end;
      2: begin g_op_mode := LEARN_2_MODE; g_auto_mode := MANUAL; end;
      3: begin g_op_mode := LEARN_3_MODE; g_auto_mode := MANUAL; end;
      end;  {end case}
   end;
end;  {Learn_Menu}


{=======================================================================}
{ Recognize_Menu:                                                       }
{=======================================================================}

procedure  Recognize_Menu;
var
   Exit_Sw : integer;
begin
   Save_Screen_1;
   Msg_Line( 25, Pop_Down_Msg );
   PullDown_Menu(Recognize_x,2,'',
                 'Level #1/Level #2/Level #3',
                 '       ^/       ^/       ^',
                 Recognize_SelNo, Exit_Sw);

   Restore_Screen_1;
   if (Exit_Sw = 1) then begin
      case Recognize_SelNo of
      1: g_op_mode := RECOG_1_MODE;
      2: g_op_mode := RECOG_2_MODE;
      3: g_op_mode := RECOG_3_MODE;
      end;  {end case}
   end;
end;  {Recognize}


{=======================================================================}
{ Display_Mem_Menu:                                                     }
{=======================================================================}

procedure  Display_Mem_Menu;
var
   Exit_Sw : integer;
begin
   Save_Screen_1;
   Msg_Line( 25, Pop_Down_Msg );
   PullDown_Menu(Display_Mem_x,2,'',
                 'Level #1/Level #2/Level #3',
                 '       ^/       ^/       ^',
                 display_mem_selNo, Exit_Sw);

   Restore_Screen_1;
   if (Exit_Sw = 1) then begin
      case display_mem_selno of
      1: begin g_memory_num := 1; Displ_Mem( recog_memory_1 ); end;
      2: begin g_memory_num := 2; Displ_Mem( recog_memory_2 ); end;
      3: begin g_memory_num := 3; Displ_Mem( recog_memory_3 ); end;
      end;  {end case}
   end;
end;  {Display_Mem_Menu}


{=======================================================================}
{ Top_Line_Menu:                                                        }
{    Handles mode management.                                           }
{=======================================================================}

procedure  Top_Line_Menu( SelNo:integer );
begin
   Across_Menu(1,1,SelNo,
'  Exit  Idle  Demo  Learn  Recognize  Displ-Memory  Quiet  Speed  Help',
'   ^    ^     ^    +^     +^         +      ^       ^      ^      ^   ',
'  0---  1---  2---  3----  4--------  5-----------  6----  7----  8---');
end;  {Top_Line_Menu}


{=======================================================================}
{ Check_Mode:                                                           }
{    Handles mode management.                                           }
{=======================================================================}

procedure  Check_Mode;

var
   InChar,NewChar,C,Dummy : char;
   Dummy_Sw,I : integer;
   FileName : string;
begin
   if (keypressed) then begin
      Beep(1550,1);
      NewChar := GetKey;
      Clear_Msg_Line( 25 );
      Empty_KeyBuf;

      Msg_Line( 25, Across_Top_Msg );

      case NewChar of
      'X': begin {exit}
              Top_Line_SelNo:=0; Top_Line_Menu(Top_Line_SelNo); Exit_Menu;
           end;
      'Z': g_exit_mode := 1;
      'I': begin {idle}
              Top_Line_SelNo:=1; Top_Line_Menu(Top_Line_SelNo);
              g_op_mode := IDLE_MODE;
           end;
      'D': begin {demo}
              Top_Line_SelNo:=2; Top_Line_Menu(Top_Line_SelNo);
              g_op_mode := LEARN_1_MODE;
              g_auto_mode := AUTO;
           end;
      'L': begin {learn}
              Top_Line_SelNo:=3; Top_Line_Menu(Top_Line_SelNo);
              Learn_Menu;
           end;
      'R': begin {recognize}
              Top_Line_SelNo:=4; Top_Line_Menu(Top_Line_SelNo);
              Recognize_Menu;
           end;
      'M': begin {display memory}
              Top_Line_SelNo:=5; Top_Line_Menu(Top_Line_SelNo);
              Display_Mem_Menu;
           end;
      'Q': begin {quiet mode}
              Top_Line_SelNo:=6; Top_Line_Menu(Top_Line_SelNo);
              if ( g_beep_mode = 1 )
                 then g_beep_mode := 0
                 else g_beep_mode := 1;
           end;
      'S': begin
              Top_Line_SelNo:=7; Top_Line_Menu(Top_Line_SelNo);
              case ( g_speed_mode ) of
              NORMAL_SPEED: g_speed_mode := FAST_SPEED;
              FAST_SPEED: g_speed_mode := SLOW_SPEED;
              SLOW_SPEED: g_speed_mode := NORMAL_SPEED;
              end;
           end;
      'H': begin {help}
              Top_Line_SelNo:=7; Top_Line_Menu(Top_Line_SelNo); Help_Index_Menu;
           end;

      #27:      begin
                   g_op_mode := 0;
                   Top_Line_SelNo := 1;  Top_Line_Menu(Top_Line_SelNo);
                end;
      #225:     begin  {left arrow}
                   if (Top_Line_SelNo > 0) then Top_Line_SelNo := Top_Line_SelNo - 1;
                   Top_Line_Menu(Top_Line_SelNo);
                end;
      #227:     begin  {right arrow}
                   if (Top_Line_SelNo < TOP_LINE_NUM_ITEMS)
                      then Top_Line_SelNo := Top_Line_SelNo + 1;
                   Top_Line_Menu(Top_Line_SelNo);
                end;
      #13,#230: begin
                   case Top_Line_SelNo of
                   0: g_exit_mode := EXIT_MODE;
                   1: g_op_mode := IDLE_MODE;
                   2: begin
                         g_op_mode := LEARN_1_MODE;
                         g_auto_mode := AUTO;
                      end;
                   3: Learn_Menu;
                   4: Recognize_Menu;
                   5: Display_Mem_Menu;
                   6: if ( g_beep_mode = 1 )
                         then g_beep_mode := 0
                         else g_beep_mode := 1;
                   7: case ( g_speed_mode ) of
                      NORMAL_SPEED: g_speed_mode := FAST_SPEED;
                      FAST_SPEED: g_speed_mode := SLOW_SPEED;
                      SLOW_SPEED: g_speed_mode := NORMAL_SPEED;
                      end;
                   8: Help_Index_Menu;  {in center of screen}
                   end;  {end case}
                end;
      else      begin  Beep(500,2);  Beep(1500,2);  Beep(500,2);  end;
      end;  {end case}

      Display_Current_Status;

   end;  {end if}
end;  {Check_Mode}


{=======================================================================}
{               B E G I N   M A I N   P R O G R A M :                   }
{=======================================================================}

label
   Next_Stimulus;
var
   NewChar                  : char;
   index, response          : word;
   stimulus_1, stimulus_2, stimulus_3, stimulus_4 : FRAME_8;
   response_1, response_2, response_3 : word;
   last_response_1, last_response_2, last_response_3 : word;

const
   pass_counter : word = 0;

begin
   Init_Screen_Buffers;  { set up for saving screen }
   Save_Screen_2;

   g_exit_mode := CONTINUE_MODE;
   textmode(BW80);

   if ( g_exit_mode = CONTINUE_MODE ) then begin

      {---------------------- initialize screen: -----------------------}
      set_window_area( 1, 1, 80, 27 );  Med_Video;
      clrscr;
      gotoXY(1,1);  Rev_Video;

      {------------------- briefly display credits: --------------------}
      Display_Credits;
      delay(2500);
      Med_Video;
      clrscr;

      {---------------- initialize learning system: --------------------}
      Init_Memory( recog_memory_1 );
      Init_Memory( recog_memory_2 );
      Init_Memory( recog_memory_3 );

      Init_Stimulus( stimulus_1 );
      Init_Stimulus( stimulus_2 );
      Init_Stimulus( stimulus_3 );

      g_memory_num := 1; Init_Stimulus_Window(1,3,13, 'stimulus #1');
      g_memory_num := 2; Init_Stimulus_Window(41,3,3, 'stimulus #2');
      g_memory_num := 3; Init_Stimulus_Window(41,8,3, 'stimulus #3');
      g_memory_num := 4; Init_Stimulus_Window(41,13,3, 'response #3');

      { ------------------ set up and init menu: ---------------------- }
      Clear_Msg_Line( 25 );
      Empty_KeyBuf;
      Msg_Line( 25, Across_Top_Msg );
      Top_Line_SelNo:=1;  Top_Line_Menu(Top_Line_SelNo);
      g_op_mode := IDLE_MODE;

      { --------- set the pseudo random seed from the clock: ---------- }
      Randomize;

      { --------------------- main real time loop: -------------------- }
      repeat

Next_Stimulus:

         Check_Mode;

         pass_counter := pass_counter + 1;
         if ( (pass_counter mod 4000) = 0 ) then Display_Message_1;

         case  g_op_mode of

         IDLE_MODE:  begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               Display_Stimulus_Window( 1,3,13, stimulus_1 );
               beep( 330, 1 ); delay(50);
            end;

         RECOG_1_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               Display_Stimulus_Window( 1,3,13, stimulus_1 );
               response_1 := Recognize( stimulus_1,
                                        recog_memory_1 );

               expand( response_1, stimulus_2 );

               g_memory_num := 2;
               Display_Stimulus_Window( 41,3,3, stimulus_2 );
               if ( response_1 > 0 )
                  then beep( response_1*50+120, 5 );
               Display_Response( 8,19, response_1 );

            end;

         RECOG_2_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               if ( g_speed_mode <> FAST_SPEED )
                  then Display_Stimulus_Window( 1,3,13, stimulus_1 );
               response_1 := Recognize( stimulus_1,
                                        recog_memory_1 );

               expand( response_1, stimulus_2 );

               g_memory_num := 2;
               Display_Stimulus_Window( 41,3,3, stimulus_2 );
               response_2 := Recognize( stimulus_2,
                                        recog_memory_2 );

               {-------------------- fatigue check: --------------------}
               if ( g_fatigue_flag[2] = 1 ) and
                  ( response_2 <> 0 ) and
                  ( response_2 = last_response_2 ) then goto Next_Stimulus;
               last_response_2 := response_2;

               expand( response_2, stimulus_3 );

               g_memory_num := 3;
               Display_Stimulus_Window( 41,8,3, stimulus_3 );

               if ( response_2 > 0 ) then begin
                  if (g_beep_mode = 1)
                     then beep( response_2*50+120, 10 )
                     else delay(300);
               end;

               Display_Response( 8,19, response_2 );
            end;

         RECOG_3_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               if ( g_speed_mode <> FAST_SPEED )
                  then Display_Stimulus_Window( 1,3,13, stimulus_1 );
               response_1 := Recognize( stimulus_1,
                                        recog_memory_1 );

               expand( response_1, stimulus_2 );

               g_memory_num := 2;
               Display_Stimulus_Window( 41,3,3, stimulus_2 );
               response_2 := Recognize( stimulus_2,
                                        recog_memory_2 );

               {-------------------- fatigue check: --------------------}
               if ( g_fatigue_flag[2] = 1 ) and
                  ( response_2 <> 0 ) and
                  ( response_2 = last_response_2 ) then goto Next_Stimulus;
               last_response_2 := response_2;

               expand( response_2, stimulus_3 );

               g_memory_num := 3;
               Display_Stimulus_Window( 41,8,3, stimulus_3 );

               response_3 := Recognize( stimulus_3,
                                        recog_memory_3 );

               {-------------------- fatigue check: --------------------}
               if ( g_fatigue_flag[3] = 1 ) and
                  ( response_3 <> 0 ) and
                  ( response_3 = last_response_3 ) then goto Next_Stimulus;
               last_response_3 := response_3;

               expand( response_3, stimulus_4 );

               g_memory_num := 4;
               Display_Stimulus_Window( 41,13,3, stimulus_4 );

               if ( response_3 > 0 ) then begin
                  if (g_beep_mode = 1)
                     then beep( response_3*50+120, 20 )
                     else delay(500);
               end;

               Display_Response( 8,19, response_3 );
            end;

         LEARN_1_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               Display_Stimulus_Window( 1,3,13, stimulus_1 );
               Learn( stimulus_1,
                      recog_memory_1 );
            end;

         LEARN_2_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               if ( g_speed_mode <> FAST_SPEED )
                  then Display_Stimulus_Window( 1,3,13, stimulus_1 );
               response_1 := Recognize( stimulus_1,
                                        recog_memory_1 );
               expand( response_1, stimulus_2 );

               g_memory_num := 2;
               Display_Stimulus_Window( 41,3,3, stimulus_2 );
               Learn( stimulus_2,
                      recog_memory_2 );
            end;

         LEARN_3_MODE: begin
               g_memory_num := 1;
               Gen_Stimulus_Input( stimulus_1 );
               if ( g_speed_mode <> FAST_SPEED )
                  then Display_Stimulus_Window( 1,3,13, stimulus_1 );
               response_1 := Recognize( stimulus_1,
                                        recog_memory_1 );
               expand( response_1, stimulus_2 );

               g_memory_num := 2;
               Display_Stimulus_Window( 41,3,3, stimulus_2 );
               response_2 := Recognize( stimulus_2,
                                        recog_memory_2 );

               {-------------------- fatigue check: --------------------}
               if ( g_fatigue_flag[2] = 1 ) and
                  ( response_2 <> 0 ) and
                  ( response_2 = last_response_2 ) then goto Next_Stimulus;
               last_response_2 := response_2;

               expand( response_2, stimulus_3 );

               g_memory_num := 3;
               Display_Stimulus_Window( 41,8,3, stimulus_3 );

               Learn( stimulus_3,
                      recog_memory_3 );
            end;
         end;

      if ( g_speed_mode = SLOW_SPEED ) then delay(250);

      until ( g_exit_mode = EXIT_MODE );

   end;

   CursorOn;  {turn it back on}
   Restore_Screen_2;
end.

{ ------------------------ End of Program ----------------------------- }